(define-module (wlroots types surface)
  #:use-module (wlroots util box)
  #:use-module (wlroots util addon)
  #:use-module (bytestructures guile)
  #:use-module ((system foreign) #:prefix ffi:)
  #:use-module (wlroots utils)
  #:use-module (wlroots types output)
  #:use-module (wayland list)
  #:use-module (oop goops)
  #:use-module (wayland listener)
  #:use-module (wayland signal)
  #:export (%wlr-surface-state-struct
            %wlr-surface-struct
            wrap-wlr-surface
            unwrap-wlr-surface
            wlr-surface-has-buffer))
(define %wlr-surface-state-struct
  (bs:struct `((committed ,uint32)
               (seq ,uint32)
               (buffer ,(bs:pointer '*))
               (dx ,int)
               (dy ,int)
               (surface-damage ,%pixman-region32-t-struct)
               (buffer-damage ,%pixman-region32-t-struct)
               (opaque ,%pixman-region32-t-struct)
               (input ,%pixman-region32-t-struct)
               (scale ,int32)
               (frame-callback-list ,%wl-list)
               (width ,int)
               (height ,int)
               (buffer-width ,int)
               (buffer-height ,int)
               (subsurfaces-below ,%wl-list)
               (subsurfaces-above ,%wl-list)
               (viewport ,(bs:struct `((has-src ,int)
                                       (has-dst ,int)
                                       (src ,%wlr-fbox-struct)
                                       (dst-width ,int)
                                       (dst-height ,int))))
               (cached-state-locks ,size_t)
               (cached-state-link ,%wl-list))))
(define %wlr-surface-struct
  (bs:struct
   `((resource ,(bs:pointer '*))
     (renderer ,(bs:pointer '*))
     (buffer ,(bs:pointer '*))
     (sx ,int)
     (sy ,int)
     (buffer-damage ,%pixman-region32-t-struct)
     (external-damage ,%pixman-region32-t-struct)
     (opaque-region ,%pixman-region32-t-struct)
     (input-region ,%pixman-region32-t-struct)
     (current ,%wlr-surface-state-struct)
     (pending ,%wlr-surface-state-struct)
     (cached ,%wl-list)
     (role ,(bs:pointer '*))
     (role-data ,(bs:pointer 'void))
     (event ,(bs:struct `((commit ,%wl-signal-struct)
                          (new-subsurface ,%wl-signal-struct)
                          (destroy ,%wl-signal-struct))))
     (current-outputs ,%wl-list)
     (addons ,%wlr-addon-set-struct)
     (data ,(bs:pointer 'void))
     (renderer-destroy ,%wl-listener)
     (previous
      ,(bs:struct `((scale ,int32)
                    (transform ,int)
                    (width ,int)
                    (height ,int)
                    (buffer-width ,int)
                    (buffer-height ,int)))))))

(define-class <wlr-surface> ()
  (pointer #:accessor .pointer #:init-keyword #:pointer))
(define (wrap-wlr-surface p)
  (make <wlr-surface> #:pointer p))
(define (unwrap-wlr-surface o)
  (.pointer o))

(define-wlr-procedure (wlr-surface-has-buffer surface)
  (ffi:int "wlr_surface_has_buffer" '(*))
  (= (% (unwrap-wlr-surface surface)) 1))
